Network Support Library/RoseWare - Network Support Library.iso/apidev/ipx751.arc/IPX_TEST.PAS

Pascal/Delphi Source File | 1988-08-25 | 5KB | 215 lines

Program Test_IPX;

Uses Crt, DirVideo, DateModl, IPXUnit;

Const
   TestSocket1 = $9990;
   TestSocket2 = $9991;

   Dt : Array[1..5] of Word = (18,27,36,45,54);  {Timer values}

Var
   ECB1, ECB2 : ECBRec;
   AES1       : AESRec;

   AES_OK : Boolean;

   ScreenTime: TimeRec;
   Sc,Sr     : Word;

{$I HEX_WORK.INC}

Procedure FlushKeyboard;
Var Ch1: Char;
Begin
   If KeyPressed then
      Begin
         Repeat
            Ch1 := ReadKey;
            Until not KeyPressed;
      End;
End;

Function SpaceFill (N,L: Word): String;
Var Ws: String[12];
Begin
   Str(N,Ws);
   SpaceFill := Ws;
   If Length(Ws)=0 then Exit;
   While Length(Ws)<L do Ws := ' '+Ws;
   SpaceFill := Ws;
End;

Procedure UpdateTime;
Var Ts: Time_String;
Begin
   Inc(Sc);
   SystemTime;
   If ScreenTime.Second=CurrTime.Second then Exit;
   Sr := Sc;
   Sc := 0;
   Disp_Str(61,2,SpaceFill(Sr,5),VaHigh);
   ScreenTime := CurrTime;
   Ts := TimeString(CurrTime);
   Delete(Ts,1,2);
   Disp_Str(61,1,' '+Ts+' ',VaRev);
End;

Function HexNodeAddr (NodeAddr: IPXNodeAddr): String;
Var M : Integer;
    Ws: String[12];
Begin
   M := 1;
   Ws := '';
   Repeat
      Ws := Ws + HexB(NodeAddr[M]);
      Inc(M);
      Until M=7;
   HexNodeAddr := Ws;
End;

Procedure Test_Get_Target;
Var TargetNode : IPXAddress;
    LocalTarget: IPXNodeAddr;
Begin
   WriteLn;
   WriteLn('Test_Get_Target');
   WriteLn('Seeking Target Node 0003:0000C0202A00:4003');
   FillChar(TargetNode,SizeOf(TargetNode),0);
   With TargetNode do
      Begin
         Network[4] := 3;
         Node[3]    := $C0;
         Node[4]    := $20;
         Node[5]    := $2A;
         Node[6]    := $00;
         Socket     := $4003;
      End;
   IPXGetTarget(TargetNode,LocalTarget);
   If IPXResultCode=0 then
      Begin
         WriteLn('   Result : Successful');
         WriteLn('   Local Target : ',HexNodeAddr(LocalTarget));
         WriteLn('   Estimated Transport : ',IPXTransTime,' clock ticks');
      End
     Else WriteLn('IPX Error : ',HexB(IPXResultCode));
End;

Procedure SoundBell (Tn: Integer);
Begin
   Sound((800+(Tn*40)));
   Delay(50);
   NoSound;
End;

Procedure Event_1;  {Routine for Timer 1}
Begin
   UpdateTime;
   Disp_Str(11,6,'EVENT 1',VaHigh);
   SoundBell(1);
   Disp_Str(11,6,'       ',VaHigh);
   AESStartEvent(1,Dt[1]);
   If IPXResultCode<>0 then
      WriteLn('AES Timer 1 Error : ',HexB(IPXResultCode));
End;

Procedure Event_2;  {Routine for Timer 2}
Begin
   Disp_Str(21,6,'EVENT 2',VaHigh);
   SoundBell(2);
   Disp_Str(21,6,'       ',VaHigh);
   AESStartEvent(2,Dt[2]);
   If IPXResultCode<>0 then
      WriteLn('AES Timer 2 Error : ',HexB(IPXResultCode));
End;

Procedure Event_3;  {Routine for Timer 3}
Begin
   Disp_Str(31,6,'EVENT 3',VaHigh);
   SoundBell(3);
   Disp_Str(31,6,'       ',VaHigh);
   AESStartEvent(3,Dt[3]);
   If IPXResultCode<>0 then
      WriteLn('AES Timer 3 Error : ',HexB(IPXResultCode));
End;

Procedure Event_4;  {Routine for Timer 4}
Begin
   Disp_Str(41,6,'EVENT 4',VaHigh);
   SoundBell(4);
   Disp_Str(41,6,'       ',VaHigh);
   AESStartEvent(4,Dt[4]);
   If IPXResultCode<>0 then
      WriteLn('AES Timer 4 Error : ',HexB(IPXResultCode));
End;

Procedure Event_5;  {Routine for Timer 5}
Begin
   Disp_Str(51,6,'EVENT 5',VaHigh);
   SoundBell(5);
   Disp_Str(51,6,'       ',VaHigh);
   AESStartEvent(5,Dt[5]);
   If IPXResultCode<>0 then
      WriteLn('AES Timer 5 Error : ',HexB(IPXResultCode));
End;

Procedure Start_All_Timers;
Var M: Integer;
Begin
   For M := 1 to 5 do
      Begin
         AESStartEvent(M,Dt[M]);
         If IPXResultCode<>0 then
            WriteLn('AES Timer ',M,' Error : ',HexB(IPXResultCode));
      End;
End;

Procedure Check_All_Timers;
Var M: Integer;
Begin
   For M := 1 to 5 do
      Begin
         If AESEventTrip(M) then
            Begin
               Case M of
                  1: Event_1;
                  2: Event_2;
                  3: Event_3;
                  4: Event_4;
                  5: Event_5;
                  End;
            End;
      End;
End;

Procedure Cancel_All_Timers;
Var M: Integer;
Begin
   For M := 1 to 5 do
      Begin
         AESAbortEvent(M);
         If IPXResultCode=0 then WriteLn('AES Timer ',M,' Cancelled.')
            Else WriteLn('AES_Abort_Event Error : Timer ',M,' ',HexB(IPXResultCode));
      End;
End;

Begin
   ClrScr;
   WriteLn('IPX Interface Testing Program');
   WriteLn;
   Sc := 0;
   Sr := 0;

   Repeat
      Start_All_Timers;
      Repeat
         Inc(Sc);
         Check_All_Timers;
         { Do main processing here }
         Until KeyPressed;
      Until KeyPressed;
   Cancel_All_Timers;
   FlushKeyboard;

End.